home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 9 / Night Owl CD-ROM (NOPV9) (Night Owl Publisher) (1993).ISO / 004a / pbclon21.zip / DEMO.BAS < prev    next >
BASIC Source File  |  1993-01-11  |  7KB  |  221 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |       PBClone  Copyright (c) 1990-1993  Thomas G. Hanlin III         |
  4. '   |                                                                      |
  5. '   +----------------------------------------------------------------------+
  6.  
  7.  
  8.  
  9.    DECLARE SUB CalcAttr (BYVAL Foreground%, BYVAL Background%, Attr%)
  10.    DECLARE FUNCTION CPUSpeed% ()
  11.    DECLARE SUB Equipment (Memory%, Parallel%, Serial%, Game%)
  12.    DECLARE SUB ExtMem (Kbytes%)
  13.    DECLARE FUNCTION Floppies2% ()
  14.    DECLARE SUB GetCRT (ColorDisplay%)
  15.    DECLARE SUB GetDOSv (MajorVersion%, MinorVersion%)
  16.    DECLARE SUB GetEGA (DisplayType%, KBytes%)
  17.    DECLARE FUNCTION GetHGA% ()
  18.    DECLARE SUB GetLIMM (TotalPages%, FreePages%)
  19.    DECLARE SUB GetLIMV (MajorVersionNum%, MinorVersionNum%)
  20.    DECLARE SUB GetVGA (IsVGA%)
  21.    DECLARE SUB GetXMSm (LargestBlock&, TotalBlocks&)
  22.    DECLARE SUB GetXMSv (MajorVersionNum%, MinorVersionNum%)
  23.    DECLARE SUB NumProc (ProcType%)
  24.    DECLARE FUNCTION PCDat$ ()
  25.    DECLARE FUNCTION PCType2% ()
  26.    DECLARE SUB Processor (CPU%)
  27.    DECLARE SUB WindowManager (TopRow%, LeftCol%, BottomRow%, RightCol%, Frame%, Fore%, Back%, Grow%, Shade%, TFore%, Title$, Page%, Fast%)
  28.    DECLARE SUB XQPrint (St$, BYVAL Row%, BYVAL Column%, BYVAL Attr%, BYVAL Page%, BYVAL Fast%)
  29.  
  30.  
  31.  
  32.    DEFINT A-Z
  33.  
  34.  
  35. '  ----- Pick the colors to use -----------------------------------------------
  36.  
  37.  
  38.    GetCRT Colour
  39.  
  40.    IF Colour THEN
  41.       CalcAttr 7, 1, Attr
  42.    ELSE
  43.       CalcAttr 7, 0, Attr
  44.    END IF
  45.  
  46.  
  47. '  ----- Clear the screen and pop up the window -------------------------------
  48.  
  49.  
  50.    CLS
  51.  
  52.    Fore = 15
  53.    IF Colour THEN
  54.       Back = 1
  55.    ELSE
  56.       Back = 0
  57.    END IF
  58.    Frame = 1
  59.    Grow = 15
  60.    Shade = 0
  61.    Title$ = "PBClone Demo"
  62.    WindowManager 2, 2, 23, 77, Frame, Fore, Back, Grow, Shade, 10, Title$, 0, 1
  63.  
  64.  
  65. '  ----- Add a text note inside the window ------------------------------------
  66.  
  67.  
  68.    Row = 3
  69.    XQPrint "This is an admittedly trivial demo for the PBClone library.  I'll", Row, 3, Attr, 0, 1
  70.    Row = Row + 1
  71.    XQPrint "improve it drastically in later versions.  However, for now it will", Row, 3, Attr, 0, 1
  72.    Row = Row + 1
  73.    XQPrint "provide an example of how to access the PBClone routines.", Row, 3, Attr, 0, 1
  74.    Row = Row + 2
  75.  
  76.  
  77. '  ----- Display processor and coprocessor types ------------------------------
  78.  
  79.  
  80.    Processor CPU
  81.    NumProc NDP
  82.    SELECT CASE CPU
  83.       CASE 0: St$ = "NEC V20"
  84.       CASE 1: St$ = "8088"
  85.       CASE 2: St$ = "80186"
  86.       CASE 3: St$ = "80286"
  87.       CASE 4: St$ = "80386"
  88.       CASE 5: St$ = "80486"
  89.       CASE ELSE: St$ = "80?86"
  90.    END SELECT
  91.    IF St$ <> "80?86" THEN
  92.       MHz = CPUSpeed
  93.       IF MHz > 0 THEN
  94.          St$ = St$ + " at about " + LTRIM$(STR$(MHz)) + " MHz"
  95.       END IF
  96.    END IF
  97.    SELECT CASE NDP
  98.       CASE 1: St$ = St$ + " with 8087 math support"
  99.       CASE 2: St$ = St$ + " with 80287 math support"
  100.       CASE 3: St$ = St$ + " with 80387 math support"
  101.       CASE ELSE
  102.    END SELECT
  103.    XQPrint "Processor: " + St$, Row, 3, Attr, 0, 1
  104.    Row = Row + 1
  105.  
  106.  
  107. '  ----- Display DOS version --------------------------------------------------
  108.  
  109.  
  110.    GetDOSv MajorV, MinorV
  111.    DOSv$ = LTRIM$(STR$(MajorV)) + "." + RIGHT$("0" + LTRIM$(STR$(MinorV)), 2)
  112.    IF MajorV > 9 THEN
  113.       St$ = "   OS/2 Compatibility Box"
  114.    ELSE
  115.       St$ = ""
  116.    END IF
  117.    XQPrint "DOS version: " + DOSv$ + St$, Row, 3, Attr, 0, 1
  118.    Row = Row + 1
  119.  
  120.  
  121. '  ----- Display basic equipment info -----------------------------------------
  122.  
  123.  
  124.    Equipment Memory, Parallel, Serial, Game
  125.    XQPrint "Base memory: " + LTRIM$(STR$(Memory)) + " Kbytes", Row, 3, Attr, 0, 1
  126.    Row = Row + 1
  127.    XQPrint "Parallel ports: " + LTRIM$(STR$(Parallel)), Row, 3, Attr, 0, 1
  128.    Row = Row + 1
  129.    XQPrint "Serial ports: " + LTRIM$(STR$(Serial)), Row, 3, Attr, 0, 1
  130.    Row = Row + 1
  131.    REM we'll leave out game ports, since that's not always reliable
  132.  
  133.    XQPrint "Floppy drives: " + LTRIM$(STR$(Floppies2)), Row, 3, Attr, 0, 1
  134.    Row = Row + 1
  135.  
  136.  
  137. '  ----- Display video adapter type -------------------------------------------
  138.  
  139.  
  140.    GetVGA IsVGA
  141.    GetEGA EGA, Memory
  142.    IF IsVGA THEN
  143.       St$ = "VGA"
  144.    ELSEIF EGA THEN
  145.       St$ = "EGA"
  146.    ELSEIF Colour THEN
  147.       St$ = "CGA"
  148.    ELSE
  149.       IF GetHGA% THEN
  150.          St$ = "Hercules"
  151.       ELSE
  152.          St$ = "MDA"
  153.       END IF
  154.    END IF
  155.    XQPrint "Display: " + St$, Row, 3, Attr, 0, 1
  156.    Row = Row + 1
  157.  
  158.  
  159. '  ----- Display BIOS date and type -------------------------------------------
  160.  
  161.  
  162.    XQPrint "ROM BIOS date: " + PCDat$, Row, 3, Attr, 0, 1
  163.    Row = Row + 1
  164.  
  165.    SELECT CASE PCType2
  166.       CASE 251, 254, 255: St$ = "PC/XT"
  167.       CASE 253: St$ = "PCjr"
  168.       CASE 252: St$ = "PC AT": ATtype = -1
  169.       CASE 250: St$ = "PS/2 Model 30"
  170.       CASE 249: St$ = "PC Convertible"
  171.       CASE 248: St$ = "PS/2 Model 70 or 80": ATtype = -1
  172.       CASE 45, 154: St$ = "Compaq Portable"
  173.       CASE ELSE: St$ = "unknown"
  174.    END SELECT
  175.    XQPrint "Computer type: " + St$, Row, 3, Attr, 0, 1
  176.    Row = Row + 1
  177.  
  178.  
  179. '  ----- Display extended and expanded memory info ----------------------------
  180.  
  181.  
  182.    IF ATtype THEN
  183.       ExtMem Memory
  184.       XQPrint "Extended memory (BIOS): " + LTRIM$(STR$(Memory)) + " Kbytes", Row, 3, Attr, 0, 1
  185.       Row = Row + 1
  186.    END IF
  187.  
  188.    IF ATtype THEN
  189.       GetXMSv MajorV, MinorV
  190.       GetXMSm LargeBlock&, TotalFree&
  191.       IF MajorV OR MinorV THEN
  192.          St$ = LTRIM$(STR$(MajorV)) + "." + RIGHT$("0" + LTRIM$(STR$(MinorV)), 2)
  193.          XQPrint "Extended memory (XMS):", Row, 3, Attr, 0, 1
  194.          Row = Row + 1
  195.          XQPrint "   Version: " + St$, Row, 3, Attr, 0, 1
  196.          Row = Row + 1
  197.          XQPrint "   Free   : " + LTRIM$(STR$(TotalFree&)) + " Kbytes", Row, 3, Attr, 0, 1
  198.          Row = Row + 1
  199.       END IF
  200.    END IF
  201.  
  202.    GetLIMM TotalPages, FreePages
  203.    IF TotalPages THEN
  204.       GetLIMV MajorV, MinorV
  205.       St$ = LTRIM$(STR$(MajorV)) + "." + RIGHT$("0" + LTRIM$(STR$(MinorV)), 2)
  206.       XQPrint "Expanded memory:", Row, 3, Attr, 0, 1
  207.       Row = Row + 1
  208.       XQPrint "   Version: " + St$, Row, 3, Attr, 0, 1
  209.       Row = Row + 1
  210.       XQPrint "   Total  : " + LTRIM$(STR$(TotalPages * 16)) + " Kbytes", Row, 3, Attr, 0, 1
  211.       Row = Row + 1
  212.       XQPrint "   Free   : " + LTRIM$(STR$(FreePages * 16)) + " Kbytes", Row, 3, Attr, 0, 1
  213.       Row = Row + 1
  214.    END IF
  215.  
  216.  
  217. '  ----- Make sure the DOS prompt doesn't get in the way ----------------------
  218.  
  219.  
  220.    LOCATE 24, 1, 1
  221.